perm filename FILL.FAI[XX,LCS]1 blob sn#163344 filedate 1975-06-11 generic text, type T, neo UTF8
00100		TITLE FILL
00200		ENTRY FILLER,LINES
00300		DEFINE FLOAT(N)
00400	   <	TLC N,232000
00500		FADR N,N   >
00600		DEFINE FIXX(N)
00700	  <	JUMPGE	N,.+5
00800		MOVNS	N
00900		FIX 	N,233000    
01000		MOVNS	N
01100		CAIA
01200		FIX	N,233000 >	; TO FIX IT LIKE 'IFIX' DOES.
01300	
01400		KK←2 ↔ L←3 ↔ LE←4 ↔ T←5 ↔ J←1
01500		RL←6 ↔ RJ←7 ↔ B←0 ↔ H←11 ↔ JK←10
01600		HG←12 ↔ D←13 ↔ AL←14 ↔ JJ←15
01700	
01800					;	SUBROUTINE FILLER(Q,M)
01900	FILLER:	0
02000		MOVEM 16,SV16#
02100		HRRZ J,(16)
02200		HRRZM J,SVQ#
02300		HRRZ T,@1(16)
02400		HRRZM T,SVM#		;	KK=NE(1)
02500		HRRZ KK,2(J)
02600		ADDI KK,-1(J)
02700					;	DO 4 K=2,KK
02800		HRRZI L,2(J)
02900					;	IF(NE(K).NE.3)GO TO 11
03000	L4:	ADDI L,3
03100		HRRZ T,(L)
03200	L11:	SETZM (L)
03300		CAIN T,3
03400					;	NE(K)=-1
03500	      	SETOM (L)
03600					;	GO TO 4
03700					; 11	NE(K)=0
03800					; 4	CONTINUE
03900		CAIGE L,(KK)
04000		JRST L4
04100					;	RLFT=10000
04200		MOVE RL,[=10000.0]
04300					;	RT=-10000
04400		MOVN RJ,[=10000.0]
04500					;	B=RT
04600		MOVE B,RJ
04700					;	DO 12 K=1,KK
04800		HRRZI L,-3(J)
04900					;	H=IFIX(Q(K))
05000	L12:	ADDI L,3
05100		MOVE H,(L)
05200		FIXX(H)
05300		FLOAT(H)
05400					;	IF(H.LT.RLFT)RLFT=H
05500		CAMGE H,RL
05600		MOVE RL,H
05700	
05800					;	IF(H.GT.RT)RT=H
05900		CAMLE H,RJ
06000		MOVE RJ,H
06100					;	IF(H.EQ.B)NE(K)=-1
06200		CAMN H,B
06300		SETOM 2(L)
06400					;	B=H
06500		MOVE B,H
06600					;	Q(K)=H
06700		MOVEM H,(L)
06800					; 12    R(K)=IFIX(R(K))
06900		MOVE T,1(L)
07000		FIXX(T)
07100		FLOAT(T)
07200		MOVEM T,1(L)
07300		CAIGE L,-2(KK)
07400		JRST L12
07500					;	NE(KK+1)=-1
07600		SETOM 3(KK)
07700	
07800					;	LRT=RT
07900		FIXX(RJ)
08000		MOVEM RJ,LRT#
08100					;	JA=3
08200		HRRZI T,3
08300		HRRZM T,JA#
08400	
08500	
08600					; 124   LEFT=RLFT
08700	L124:	MOVE LE,RL
08800		FIXX(LE)
08900					; 51    J=LEFT
09000	L51:	MOVE J,LE
09100					; 42    RJ=J+.001
09200	L42:	MOVE RJ,J
09300		FLOAT(RJ)
09400		FADR RJ,[=0.001]
09500					;	JCONT=0
09600		SETZM JCONT#
09700					;	LEFT=J
09800		MOVE LE,J
09900	
10000					;	JJ=-1
10100		SETO JJ,
10200					;	ALT=-10000.
10300		MOVN AL,[=10000.0]
10400					; 200   DO 45 L=2,KK
10500		HRRZ L,SVQ
10600	L45:	ADDI L,3
10700		CAILE L,-2(KK)
10800		JRST L455
10900					;	IF(NE(L).NE.0)GO TO 45
11000		SKIPE 2(L)
11100		JRST L45
11200					;	IF(MISS(L,RJ,Q))GO TO 45
11300		CAML RJ,-3(L)
11400		JRST L201
11500		CAMLE RJ,(L)
11600		JRST L202
11700	L201:	CAMGE RJ,(L)
11800		CAMG RJ,-3(L)
11900		JRST L45
12000					;	H=HGHT(L,RJ,Q,R)
12100	L202:	MOVE H,-2(L)
12200		CAMN H,1(L)
12300		JRST RET
12400		MOVNS H
12500		FADR H,1(L)
12600		MOVE D,-3(L)
12700		MOVNS T,D
12800		FADR T,RJ
12900		FADR D,(L)
13000		FMPR H,T
13100		FDVR H,D
13200		FADR H,-2(L)
13300					;	IF(H.LT.ALT)GO TO 45
13400	RET:	CAMGE H,AL
13500		JRST L45
13600	
13700					;	ALT=H
13800		MOVE AL,H
13900					;	JJ=L
14000		HRRZI JJ,(L)
14100					; 45    CONTINUE
14200		JRST L45
14300					;	IF(JJ)GO TO 43
14400	L455:	JUMPL JJ,L43
14500					;	JCONT=-1
14600		SETOM JCONT
14700					;	LEFT=J
14800		MOVE LE,J
14900					; 46    JA=3
15000	L46:	HRRZI T,3
15100		HRRZM T,JA
15200					;	JORD=-1
15300		SETOM JORD#
15400					; 52    KN=Q(JJ)
15500	L52:	MOVE T,(JJ)
15600		FIXX(T)
15700		MOVEM T,KN#
15800					;	KL=Q(JJ-1)
15900		MOVE T,-3(JJ)
16000		FIXX(T)
16100	
16200		MOVEM T,KL#
16300					;	IF(KN.LT.KL)KN=KL
16400		CAMLE T,KN
16500		MOVEM T,KN
16600					; 50    I=J
16700	L50:	MOVEM J,I#
16800					; 102   RJ=I+.01
16900	L102:	MOVE RJ,I
17000		FLOAT(RJ)
17110		FADR RJ,[=0.1]	;6/11/75 ←←**↑↑ WAS 0.01 -- CHECK TIGHT CASES!!
17200					;	ALT=HGHT(JJ,RJ,Q,R)
17300		MOVE AL,-2(JJ)
17400		CAMN AL,1(JJ)
17500		JRST RET2
17600		MOVNS AL
17700		FADR AL,1(JJ)
17800		MOVE D,-3(JJ)
17900		MOVNS T,D
18000		FADR T,RJ
18100		FADR D,(JJ)
18200		FMPR AL,T
18300		FDVR AL,D
18400		FADR AL,-2(JJ)
18500					;	B=-10000
18600	RET2:	MOVN B,[=10000.0]
18700					;	JK=-1
18800		SETO JK,
18900					;	XALT=ALT+.001
19000		MOVE T,AL
19100		FADR T,[=0.001]
19200		MOVEM T,XALT#
19300	
19400					;	ZALT=ALT
19500		MOVEM AL,ZALT#
19600					; 400   DO 47 L=2,KK
19700		MOVE L,SVQ
19800	L47:	ADDI L,3
19900		CAILE L,-2(KK)
20000		JRST L477
20100				;	IF(L.EQ.JJ.OR.MISS(L,RJ,Q).OR.NE(L).LT.0)GO TO 47
20200		CAME L,JJ
20300		SKIPGE 2(L)
20400		JRST L47
20500		CAML RJ,-3(L)
20600		JRST L475
20700		CAMLE RJ,(L)
20800		JRST L476
20900	L475:	CAMGE RJ,(L)
21000		CAMG RJ,-3(L)
21100		JRST L47
21200					;	H=HGHT(L,RJ,Q,R)
21300	L476:	MOVE H,-2(L)
21400		CAMN H,1(L)
21500		JRST RET3
21600		MOVNS H
21700		FADR H,1(L)
21800		MOVE D,-3(L)
21900		MOVNS T,D
22000		FADR T,RJ
22100		FADR D,(L)
22200		FMPR H,T
22300		FDVR H,D
22400		FADR H,-2(L)
22500					;	IF(H.GT.XALT)GO TO 47
22600	RET3:	CAMG H,XALT
22700	
22800					;	IF(H.LE.B)GO TO 47
22900		CAMG H,B
23000		JRST L47
23100					;	B=H
23200		MOVE B,H
23300					;	JK=L
23400		HRRZI JK,(L)
23500					; 47    CONTINUE
23600		JRST L47
23700					;	IF(JK)GO TO 48
23800	L477:	JUMPL JK,L48
23900					;	300   IF(ZALT-B.GT..001.OR.I.NE.J)GO TO 59
24000		MOVN T,B
24100		FADR T,ZALT
24200		CAMG T,[=0.001]
24300		CAME J,I
24400		JRST L59
24500					;	JX=Q(JK)
24600		MOVE T,(JK)
24700		FIXX(T)
24800					;	IF(JX.GT.KN)GO TO 60
24900		CAMLE T,KN
25000		JRST L60
25100					;	JX=Q(JK-1)
25200		MOVE T,-3(JK)
25300		FIXX(T)
25400					;	IF(JX.LT.KN)GO TO 59
25500		CAMGE T,KN
25600		JRST L59
25700					; 60    L=JJ
25800	L60:	MOVE L,JJ
25900					;	JJ=JK
26000		MOVE JJ,JK
26100					;	JK=L
26200		MOVE JK,L
26300					;	KN=JX
26400		MOVEM T,KN
26500	
26600					; 59    IF(ALT-B.LT.2)GO TO 62
26700	L59:	MOVN T,B
26800		FADR T,AL
26900		CAMGE T,[=2.0]
27000		JRST L62
27100					;	ALT=ALT-1
27200		HRLZI T,576400
27300		FADR AL,T
27400					;	B=B+1
27500		HRLZI T,201400
27600		FADR B,T
27700					; 62    IF(JORD)GO TO 103
27800	L62:	SKIPGE JORD
27900		JRST L103
28000					;	H=B
28100		MOVE H,B
28200					;	B=ALT
28300		MOVE B,AL
28400					;	ALT=H
28500		MOVE AL,H
28600					;	IF(JK.NE.NK.AND.ABS(ALT-B).GT.5.)JA=3
28700	
28800		CAMN JK,NK#
28900		JRST L103
29000		MOVN T,B
29100		FADR T,AL
29200		SKIPGE T
29300		MOVNS T
29400		CAMG T,[5.0]
29500		JRST L103
29600		HRRZI T,3
29700		HRRZM T,JA
29800					; 103   CALL LINES(RJ,ALT,JA)
29900	L103:	MOVEM RJ,SVRJ#
30000		MOVEM AL,SVAL#
30100		MOVEM B,SVB#
30200		HRRZI 16,SVAC
30300		BLT 16,SVAC+15
30400		JSA 16,LINES
30500		JUMP SVRJ
30600		JUMP SVAL
30700		JUMP JA
30800					; 100   CALL LINES(RJ,B,2)	
30900		JSA 16,LINES
31000		JUMP SVRJ
31100		JUMP SVB 
31200		JUMP [2]
31300		HRLZI 16,SVAC
31400		BLT 16,15
31500					;	NK=JK
31600		MOVEM JK,NK
31700	
31800					;	JORD=-JORD
31900		MOVNS JORD
32000					;	NE(JK)=1
32100		HRRZI T,1
32200		HRRZM T,2(JK)
32300					;	NE(JJ)=-1
32400		SETOM 2(JJ)
32500					;	JA=2
32600		HRRZI T,2
32700		HRRZM T,JA
32800					;	I=I+M
32900		MOVE T,SVM
33000		ADDB T,I
33100					;	IF(I.LT.KN)GO TO 102
33200		CAMGE T,KN
33300		JRST L102
33400					;	L=1
33500		HRRZI L,3
33600					;	IF(KN.EQ.KL)L=-1
33700		MOVE T,KN
33800		CAMN T,KL
33900		HRROI L,-3
34000					;	JJ=JJ+L
34100		ADD JJ,L
34200					;	J=0
34300		SETZ J,
34400					;	IF(L)J=-1
34500		SKIPGE L
34600		HRROI J,-3
34700			;	IF(KN+M.GT.Q(JJ+J).OR.JJ.GT.KK.OR.NE(JJ).NE.0)GO TO 124
34800		SKIPN 2(JJ)
34900		CAILE JJ,-2(KK)
35000		JRST L124
35100		ADD T,SVM
35200		FLOAT(T)
35300		HRRZI HG,(JJ)
35400		ADD HG,J
35500		CAMLE T,(HG)
35600		JRST L124
35700					;	J=I
35800		MOVE J,I
35900					;	GO TO 52
36000		JRST L52
36100					; 48    JA=3
36200	L48:	HRRZI T,3
36300		HRRZM T,JA
36400					; 43    J=LEFT+M
36500	L43:	MOVE J,LE
36600		ADD J,SVM
36700					;	IF(J.LE.LRT)GO TO 42
36800		CAMG J,LRT
36900		JRST L42
37000					;	IF(JCONT)GO TO 51
37100		SKIPGE JCONT
37200		JRST L51		;	END
37300		MOVE 16,SV16
37400		JRA 16,2(16)
37500	SVAC:	BLOCK 16
37600	
37700	
37800		EXTERNAL DST,SIZ,PLTR,DPY,AIVECT,AVECT,.COMM.
37900			;	SUBROUTINE LINES(A,B,L)
38000			;	COMMON/DST/BB,CC
38100	   		;	COMMON /SIZ/RSZ,JCEN,KCEN /FL/IC,NZ,NX,RZ,XGP
38200			;	COMMON/DL/IXRX,SAVER,AA /PLTR/IPLT,RHT,DIS
38300			;	COMMON R2,JA,CENTR,JB,RJQ(20),JQ(20)
38400			;	COMMON/DPY/JJ(4000),WDS(250),MEDIT,IGO
38500			;	EQUIVALENCE (ITOP,JJ(3999)),(IBOT,JJ(4000))
38600			;	1,(JJ2,JJ(2))
38700			;	DATA BB/.008/,CC/3.5/
38800	 		;C  SET XGP TO 1200.0 FOR MARGIN IN XEROX COPIES
38900		
39000		M←2 ↔ N←3 ↔ K←4
39100	
39200	LINES:	0
39300				;	GO TO 23
39400		JRST L23
39500				;22	IF(JQ(1).NE.0)GO TO 23
39600	L22:	SKIPE PLTR+=27
39700		JRST L23
39800				;	IF(CC.EQ.1000)GO TO 23
39900		MOVSI T,212764
40000		CAMN T,DST+1
40100		JRST L23
40200				;	B=B*(CC-BB*ABS(A))
40300		MOVE T,@(16)
40400		MOVM	T,T
40500		FMPR T,DST
40600		FSBR T,DST+1
40700		FMPRM T,@1(16)
40800		MOVNS @1(16)
40900				;23	IF(IPLT)GO TO 2
41000				;	M=A*RSZ
41100	L23:	MOVE M,@(16)
41200		FMPR M,SIZ
41300		FIXX(M)
41400				;	N=B*RSZ
41500		MOVE N,@1(16)
41600		FMPR N,SIZ
41700		FIXX(N)
41800				;	IF(RSZ.LE.0.8571)GO TO 3
41900		MOVE T,[=0.8571]
42000		CAML T,SIZ
42100	;;	JRST L3
42200		JRST L6
42300	
42400		SUB M,SIZ+1		;	M=M-JCEN
42500		SUB N,SIZ+2		;	N=N-KCEN
42600				;	IF(JA.NE.8)GO TO 5
42700		MOVEI T,10
42800		CAME T,.COMM.+1
42900		JRST L5
43000				;	IF(M.GT.511)M=511
43100		CAMLE M,[=511]
43200		HRRZI M,=511
43300				;	IF(M.LT.-511)M=-511
43400		CAMGE M,[-=511]
43500		HRROI M,-=511
43600				;5	IF(IABS(M).GT.512)GO TO 77
43700	L5:	CAIG M,=512
43800		CAMGE M,[-=512]
43900		JRST L77
44000				;	IF(IABS(N).LT.512)GO TO 4
44100		CAIGE N,=512
44200		CAMG N,[-=512]
44300		CAIA
44400		JRST LL4
44500				;77	KZ=-1
44600	L77:	SETOM KZ#
44700				;	RETURN
44800		JRA 16,3(16)
44900				;4	IF(KZ.EQ.0)GO TO 6
45000	LL4:	SKIPN KZ
45100		JRST L6
45200				;	KZ=0
45300		SETZM KZ
45400		MOVEM M,MM#	;	GO TO 1
45500		MOVEM N,NN#
45600		JRST L1
45700				;3	IF(JA.EQ.44)GO TO 6
45800				;6	IF(JJ2.GT.3990)RETURN
45900	L6:   	MOVEI T,7626
46000		CAMGE T,DPY+1
46100		JRA 16,3(16)
46200				;	IF(L.EQ.3)GO TO 1
46300		MOVEM M,MM
46400		MOVEM N,NN
46500		HRRZI T,3
46600		CAMN T,@2(16)
46700		JRST L1
46800				;	CALL AVECT(M,N)
46900		JSA 16,AVECT
47000		JUMP MM
47100		JUMP NN
47200				;	RETURN
47300		JRA 16,3(16)
47400				;1	CALL AIVECT(M,N)
47500	L1:   	JSA 16,AIVECT
47600		JUMP MM
47700		JUMP NN
47800				;	RETURN
47900		JRA 16,3(16)
48000				;2	IF(IPLT.EQ.-2)RETURN
48100	;;L2:   	MOVNI T,2
48200	;;	CAMN T,PLTR
48300	;;	JRA 16,3(16)
48400		END